COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE WRIFUN
C00011 ENDMK
C⊗;
	SUBROUTINE WRIFUN
	COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
	1,LX,JX,J,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
	COMMON FUNC(512),F2(512),K,I
	DATA ARY/'ARRAY'/,R999/999.0/,MX/' '/
24	FORMAT(' TYPE FUNCTION NAME   '$)
34	FORMAT(A5,'(',A5,');',A5)
35	FORMAT(1XA5,'IN FILE "',A5,'.FUN"'/)
37	FORMAT(8F10.4)
39	FORMAT(A5,10(A1,A3))
391	FORMAT(A3)
390	FORMAT(A1)
43	FORMAT(' NO ROOM IN FILE  "',A5,'.FUN"')
44	FORMAT(' FUNCTIONS ALREADY IN FILE - ',A5)
45	FORMAT('(512);')

	IF(IDEL.NE.0)GO TO 292
C  FOR DELETIONS
	IF(Z.EQ.'N')GO TO 912
	IF(FLNM.EQ.FLNM1)GO TO 1922
C  JUMP IF THAT FILE IS NOW IN CORE
	FLNM1=0
C  ↑↑↑↑↑↑ TO GUARD AGAINST CONFUSION IN BACKUPS.
	CALL READ1
1922	IF(Z.EQ.'N')GO TO 912
CC COLGATE 7/741922	TYPE 44,FLNM
	TYPE 44,FLNM
C  FUNCS. IN FILE
	TYPE 39,MX,B
912	TYPE 24
	ACCEPT 390,FNUM
	IF(FNUM.EQ.'B')RETURN
C  FOR BACKUP
	IF(FNUM.EQ.' ')GO TO 1922
	REREAD 391,FNUM
	IF(Z.EQ.'N')GO TO 911
	IF(Z.NE.-1)GO TO 90
C JUMP IF .NE. 'RENAME'
C 7/74 COLGATE
	DO 30 K=1,LX-1
	IF(K.EQ.JX.OR.FN(K).NE.FNUM)GO TO 30
	TYPE 31
	CALL EXIT
31	FORMAT(/' FUNC NAME IN USE!')
30	CONTINUE
	B(2,JX)=FNUM
	FN(JX)=FNUM
	LX=LX-1
	GO TO 1906
90	IF(FLNM.EQ.FLNM1)GO TO 1090
	FNUM1=0
	LX=0
C  TO PUT NEW FUNC IN OLD FILE
	CALL READER
1090	JX=0
	DO 20 K=1,LX-1
	IF(FNUM.NE.FN(K))GO TO 20
	JX=K
	LX=LX-1
	GO TO 21
20	CONTINUE
210	JX=LX
C  JX=LX IF FNUM WAS NOT FOUND
	IF(JX.GT.10)GO TO 193
21	FN(JX)=FNUM
	X='SEG'
	IF(J.EQ.4)X='SYNTH'
	XA(JX)=X
	CALL STORE(JX)
	IF(J.EQ.2)GO TO 1192
	AA(1,KT,JX)=999
	GO TO 192
1192	IF(A(KT-1,2).EQ.100)GO TO 192
C  JUMP IF NO SMOOTHING
	DO 2192 K=1,512
2192	AA(K,KT,JX)=FUNC(K)

192	IF(JX.NE.1)B(1,JX)=','
	B(2,JX)=FNUM
	GO TO 1906
193	TYPE 43,FLNM
C  NO ROOM IN FILE.
	RETURN
C  NEW FILE
911	LX=1
	DO 94 K=1,20
94	B(K,1)=' '
	GO TO 210
C  CLEARS B FOR NEW, SINGLE ITEM.
292	IF(IDEL.EQ.10)GO TO 932
	DO 931 K=IDEL,LX-1
931	B(2,K)=B(2,K+1)
932	B(1,LX)=' '
	B(2,LX)=' '
1906	REWIND 1
	IF(Z.EQ.'N'.OR.IDEL.GT.0)GO TO 22
	DO 25 K=1,LX
	IF(K.GT.1.AND.B(1,K).NE.',')GO TO 26
	X=B(2,K)
	IF(X.NE.' '.AND.X.EQ.FN(K))GO TO 25
26	TYPE 23
	RETURN
23	FORMAT(/' CONFUSION IN THIS FILE. TRY ANOTHER! '/)
25	CONTINUE
22	CALL FORNAM(FLNM,'FUN')
C  WRITES FILE WITH EXTENSION .FUN
CF22	CALL OFILE(1,FLNM)
CC  NOT YET! 22	CALL OFLE(1,FLNM,'.FUN')
C  COLGATE OFILE REPLACEMENT.  ALL FUNC FILES WILL BE '.FUN'.
	WRITE(1,39),ARY,B
	WRITE(1,45)
69	NX=0
1905	IF(NX.EQ.LX)GO TO 904
C  LX=TOTAL # OF FUNCS
	NX=NX+1
	IF(IDEL.EQ.NX)GO TO 1905
C  SO THAT DATA MUST ALWAYS BE READ FROM DSK AFTER A DEL.
1	J=4
	X='   99'
	IF(XA(NX).NE.'SEG')GO TO 68
	J=2
	X=' '
68	WRITE(1,34),XA(NX),FN(NX),X
	JX=0
2905	JX=JX+1
	IF(J.EQ.2)GO TO 3905
	IF(AA(1,JX,NX).EQ.999)GO TO 5905
C  FOUND END OF A SYNTH
	WRITE(1,37),(AA(K,JX,NX),K=1,4)
	GO TO 2905
5905	WRITE(1,37)R999
	GO TO 1905
3905	X=AA(2,JX,NX)
	WRITE(1,37),AA(1,JX,NX),X
	IF(X.EQ.100)GO TO 1905
C  FOUND END OF A SEG
	IF(X.LT.100)GO TO 2905
	WRITE(1,37)(AA(K,JX+1,NX),K=1,512)
	GO TO 1905
904	TYPE 39,MX,B
	IF(IDEL.EQ.0)TYPE 35,FNUM,FLNM
	IF(IDEL.NE.0)FLNM=0
	LX=LX+1
C  FOR RESTARTS
	CALL DDCLR
C****** REMOVE ABOVE FOR EXPORT VERSION.  USED TO CLEAR DATADISC.
	CALL EXIT
	END

	SUBROUTINE READER
	COMMON/LN/LINE
	COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
	1,LX,JX,J,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
	COMMON FUNC(512),F2(512),K,I
37	FORMAT(8F)
38	FORMAT(3(A5,A1))
380	FORMAT(I,3(A5,A1))
39	FORMAT(9A5)
	READ (1,39),K,K,AK
C  READS "(512);"
C  LX IS MAIN COUNTER
401	LX=LX+1
1	IF(LINE.EQ.0)READ(1,38,END=4401)XA(LX),Y,FN(LX),H,H
	IF(LINE)READ(1,380,END=4401)K,XA(LX),Y,FN(LX),H,H
	IF(XA(LX).GE.0)GO TO 1
C  TO FIND EOF AFTER COPY SCREWUPS
	IF(FNUM1.EQ.FN(LX))JX=LX
C  JX TELLS WHERE TO FIND FUNCTION TO BE LOOKED AT.
C  XA(LX) IS FUNC. TYPE (SEG OR SYNTH)
	X=0
	N=4
	IF(XA(LX).EQ.'SEG')N=2
	KX=0
C  KX IS LOCAL COUNTER
1401	IF(X.EQ.100)GO TO 401
	KX=KX+1
	IF(LINE.EQ.0)READ(1,37),(AA(K,KX,LX),K=1,N)
	IF(LINE)READ(1,37)AK,(AA(K,KX,LX),K=1,N)
	IF(N.EQ.2)GO TO 2401
	IF(AA(1,KX,LX).EQ.999)GO TO 401
C  FOUND END OF A SYNTH
	GO TO 1401
2401	X=AA(2,KX,LX)
	IF(X.LE.100)GO TO 1401
C  NEXT IS FOR SMOOTHED SEGS
	N=KX+1
	IF(LINE)GO TO 2
	READ(1,37)(AA(K,N,LX),K=1,512)
	GO TO 401
370	FORMAT(9F)
2	DO 3 K=1,512,8
3	READ(1,370)AK,(AA(KX,N,LX),KX=K,K+7)
	GO TO 401
4401	END


	SUBROUTINE READ1
C  READS FIRST LINE OF FILE ONLY
	COMMON/LN/LINE
	COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
	1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
2151	REWIND 1
	CALL FORNAM(FLNM,'FUN')
CC	CALL IFILE(1,FLNM)
CC  NOT YET!	CALL IFLE(1,FLNM,'.FUN')
	READ (1,39),X,B
	IF(X.NE.'COMME')GO TO 1
	TYPE 2
	X=-X
1	LINE=0
	IF(X)RETURN
	LINE=-1
C  FOUND LN #S (CAN'T READ SMOOTHS 'THO)
	REREAD 390,LX,X,B
2	FORMAT(' ***** WON''T READ "ET" FILES! *****')
39	FORMAT(A5,10(A1,A3))
390	FORMAT(I,A5,10(A1,A3))
	END

	SUBROUTINE STORE(N)
	COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
	1,LX,JX,J,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
	DO 3090 K=1,KT-1
	DO 3090 L=1,J
3090	AA(L,K,N)=A(K,L)
	END